home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / util / shell / ShellScr.lha / ShellScr / src / ShellScr.e < prev   
Encoding:
Text File  |  1998-04-10  |  8.7 KB  |  293 lines

  1. -> ShellScr v1.4 by Kyzer/CSG
  2. -> Creates a fullscreen shell with it's own public screen
  3.  
  4. OPT PREPROCESS,OSVERSION=37
  5.  
  6. MODULE 'asl', 'diskfont', 'dos/dos', 'dos/dostags', 'exec/nodes',
  7.        'graphics/text', 'intuition/screens', 'libraries/asl',
  8.        'utility/tagitem', 'workbench/startup',
  9.        '*args', '*clr', '*defarg', '*paths'
  10.  
  11. RAISE "MEM" IF String()=NIL
  12.  
  13. #define TEMPLATE \
  14.  'PUBNAME=NAME,MODEID=ID,DEPTH/N,FONT/K,'+\
  15.  'SCREENTITLE=TITLE,NOTITLE=HIDETITLE/S,'+\
  16.  'CONSPEC=WINDOW,COMMANDFILE=FROM'
  17.  
  18. OBJECT myargs
  19.   pubname    -> chosen public screen name or NIL
  20.   modeid    -> string referencing mode-id or NIL
  21.   depth        -> ptr to LONG number or NIL: depth of screen
  22.   font        -> ptr to font description ('fontname/size') or NIL
  23.  
  24.   title        -> string: name of titlebar or NIL
  25.   notitle    -> boolean, non-zero = hide titlebar, zero = show titlebar
  26.  
  27.   conspec    -> WINDOW parameter of NewShell
  28.   cmdfile    -> FROM parameter of NewShell
  29. ENDOBJECT
  30.  
  31. DEF args:myargs, rdargs=NIL, sig, pubname[16]:STRING
  32.  
  33. PROC main() HANDLE
  34.   DEF wbmsg:PTR TO wbstartup, dir, newdir=NIL, screen=NIL
  35.  
  36.   -> allocate a signal bit
  37.   IF (sig := AllocSignal(-1))=-1 THEN RETURN
  38.  
  39.   -> generate default name for a public screen
  40.   StringF(pubname, 'SHELL_\z\h[8]', FindTask(NIL))
  41.  
  42.   -> read arguments with fabulous wb-friendly readargs()
  43.   clr(args, SIZEOF myargs)
  44.   IF (rdargs:=readargs(TEMPLATE, args, wbmessage))=NIL THEN Raise("args")
  45.  
  46.   -> choose reasonable start directory from WB
  47.   IF wbmsg := wbmessage
  48.     IF wbmsg.numargs > 1 THEN newdir := DupLock(wbmsg.arglist[1].lock)
  49.     IF newdir=NIL THEN newdir := DupLock(GetProgramDir())
  50.     IF newdir THEN dir := CurrentDir(newdir)
  51.   ENDIF
  52.  
  53.   -> open the screen, construct the command, run it
  54.   SystemTagList(
  55.     makecmd(screen := openscr()),
  56.     NEW [NP_PATH, getpath(), TAG_DONE]
  57.   )
  58.  
  59.   -> wait for "last-window-gone" signal (or CTRL-C, for no good reason :)
  60.   Wait(Shl(1,sig) OR SIGBREAKF_CTRL_C)
  61.  
  62.   WHILE CloseScreen(screen)=0 DO EasyRequestArgs(NIL, [20, 0, 'ShellScr',
  63.     'This screen is closing. Please close all visitor windows.', 'OK'], 0, 0
  64.   )
  65.  
  66. EXCEPT DO
  67.   SELECT exception
  68.   CASE "MEM";  SetIoErr(ERROR_NO_FREE_STORE); msg(error())
  69.   CASE "LIB";  SetIoErr(ERROR_INVALID_RESIDENT_LIBRARY); msg(error())
  70.   CASE "args"; msg(error('Bad args'))
  71.   CASE "dfsc"; msg('Cannot get a default screen')
  72.   CASE "scr";  msg('Cannot open screen: \s', NEW [screenerror(exceptioninfo)])
  73.   ENDSELECT
  74.  
  75.   IF newdir THEN CurrentDir(dir)
  76.   IF newdir THEN UnLock(newdir)
  77.   IF rdargs THEN FreeArgs(rdargs)
  78.   FreeSignal(sig)
  79. ENDPROC
  80.  
  81.  
  82. ->-----------------------------------------------------------------------------
  83.  
  84.  
  85. PROC makecmd(s:PTR TO screen)
  86.   -> create the 'NewShell' command required
  87.   DEF cmd, cmdformat, sizes, top, scrname
  88.  
  89.   -> generate command formatter :  'NewShell [conspec] [FROM cmdfile]'
  90.   -> conspec contains two '%s' ('\s') formatters for windowsize and screenname
  91.   StringF(
  92.     cmdformat:=String(
  93.       9 +
  94.       (IF args.conspec THEN StrLen(args.conspec)   ELSE 64) +
  95.       (IF args.cmdfile THEN StrLen(args.cmdfile)+6 ELSE 0)
  96.     ),
  97.     'NewShell \s\s\s',
  98.     defarg(args.conspec,
  99.       'CON:\s//BACKDROP/NOBORDER/NOSIZE/NODRAG/NODEPTH/NOCLOSE/SCREEN\s'
  100.     ),
  101.     IF args.cmdfile THEN ' FROM ' ELSE '',
  102.     defarg(args.cmdfile, '')
  103.   )
  104.  
  105.   -> window-size calculation (see guide)
  106.   top:=IF args.notitle THEN 0 ELSE IF args.conspec THEN s.barheight+1 ELSE 3
  107.   StringF(sizes:=String(23), '\d/\d/\d/\d', 0, top, s.width, s.height-top)
  108.  
  109.   -> name of public screen
  110.   scrname := defarg(args.pubname, pubname)
  111.  
  112.   -> create final command from format template
  113.   StringF(
  114.     cmd:=String(EstrLen(cmdformat) + EstrLen(sizes) + StrLen(scrname)),
  115.     cmdformat, sizes, scrname
  116.   )
  117. ENDPROC cmd
  118.  
  119.  
  120. ->-----------------------------------------------------------------------------
  121.  
  122.  
  123. PROC openscr() HANDLE
  124.   -> opens the screen as requested by the user
  125.  
  126.   DEF ds=NIL:PTR TO screen, dri=NIL:PTR TO drawinfo, s=NIL:PTR TO screen,
  127.       fontdesc=NIL:PTR TO textattr, font=NIL:PTR TO textfont, name, size,
  128.       errorcode
  129.  
  130.   ->--- font support
  131.   -> find out the real name/size of our requested (or not) font
  132.   -> assume we must load first instance of font from disk first
  133.   -> tsssk the user if he picked a proportional font
  134.  
  135.   name, size := getfont(args.font)
  136.  
  137.   IF name THEN
  138.     IF  diskfontbase := OpenLibrary('diskfont.library', 37) THEN
  139.       IF font := OpenDiskFont(fontdesc:=NEW [name, size, 0, 0]:textattr) THEN
  140.         IF font.flags AND FPF_PROPORTIONAL THEN
  141.           msg('Requested font "\s/\d" is not fixed-width!', NEW [name, size])
  142.  
  143.   -> Find a default screen to read information about
  144.   IF (ds := LockPubScreen(NIL))=NIL THEN Raise("dfsc")
  145.  
  146.   dri := GetScreenDrawInfo(ds)
  147.  
  148.   s := OpenScreenTagList(NIL, NEW [
  149.     SA_PUBNAME,     defarg(args.pubname, pubname),
  150.     SA_PUBSIG,      sig,
  151.     SA_PUBTASK,     FindTask(NIL),
  152.     SA_TYPE,        PUBLICSCREEN,
  153.     SA_DISPLAYID,   defarg(getmode(args.modeid), GetVPModeID(ds.viewport)),
  154.  
  155.     SA_TITLE,       defarg(args.title, 'AmigaShell'),
  156.     SA_SHOWTITLE,   IF args.notitle THEN FALSE ELSE TRUE,
  157.     SA_FONT,        defarg(fontdesc, IF ds.font.flags AND
  158.                            FPF_PROPORTIONAL THEN NIL ELSE ds.font),
  159.  
  160.     SA_DEPTH,       IF args.depth THEN Long(args.depth) ELSE 2,
  161.     SA_FULLPALETTE, TRUE,
  162.     SA_PENS,        IF dri THEN dri.pens ELSE [-1]:INT,
  163.  
  164.     SA_ERRORCODE,   {errorcode},
  165.     TAG_DONE
  166.   ])
  167.  
  168.   IF s=NIL THEN Throw("scr", errorcode)
  169.  
  170.   PubScreenStatus(s, PUBLICSCREEN) -> make screen go public
  171.  
  172. EXCEPT DO
  173.   CloseLibrary(diskfontbase)
  174.   CloseLibrary(aslbase)
  175.  
  176.   IF dri  THEN FreeScreenDrawInfo(ds, dri)
  177.   IF ds   THEN UnlockPubScreen(NIL, ds)
  178.  
  179.   IF font THEN CloseFont(font)
  180.   ReThrow()
  181. ENDPROC s
  182.  
  183.  
  184. ->-----------------------------------------------------------------------------
  185.  
  186.  
  187. PROC getmode(modename)
  188.   -> process string with hex/decimal/'?'/'' modeid and return numeric ID
  189.   DEF modeid, req:PTR TO screenmoderequester, ok
  190.  
  191.   IF modename=NIL THEN RETURN 0
  192.  
  193.   -> ASL screenmode requester when modename='?' or ''
  194.   IF (StrCmp(modename, '?') OR StrCmp(modename, '')) AND asl()
  195.     IF req := AllocAslRequest(ASL_SCREENMODEREQUEST, NIL)
  196.       IF ok := AslRequest(req, NIL) THEN
  197.         msg('Chosen MODEID = 0x\h', NEW [modeid := req.displayid])
  198.       FreeAslRequest(req)
  199.     ENDIF
  200.     RETURN IF ok THEN modeid ELSE 0
  201.   ENDIF
  202.  
  203.   -> otherwise - a numeric ID.
  204.  
  205.   -> change '0xB1AB1A' into '$B1AB1A'
  206.   IF StrCmp(modename, '0x', 2); INC modename; modename[]:="$"; ENDIF
  207. ENDPROC Val(modename)
  208.  
  209. ->----
  210.  
  211. PROC getfont(fontname) HANDLE
  212.   -> process font-string (eg 'topaz/11', 'flyspeck', '?') and return
  213.   -> proper name and size ('topaz.font',11 , 'flyspeck.font',8 , ...)
  214.   -> requires slightly different coding to the modeid processor...
  215.   DEF font=NIL, size=8, req=NIL:PTR TO fontrequester, ok, n
  216.  
  217.   IF fontname=NIL THEN Raise()
  218.  
  219.   -> ASL font requester on fontname='?' or fontname=''
  220.   IF (StrCmp(fontname, '?') OR StrCmp(fontname, '')) AND asl()
  221.     IF req := AllocAslRequest(ASL_FONTREQUEST, NIL)
  222.       IF AslRequest(req, [ASLFO_FIXEDWIDTHONLY, TRUE, TAG_DONE])
  223.         fontname := req.attr.name; size := req.attr.ysize
  224.       ENDIF
  225.     ENDIF
  226.   ENDIF
  227.  
  228.   -> copy fontname so we can (perhaps) modify it
  229.   StrCopy(font:=String(StrLen(fontname)+5), fontname)
  230.  
  231.   -> look for and remove size (in 'myfont/99' format) from string
  232.   IF (n := InStr(font, '/'))<>-1
  233.     -> get size from string (or 8 as default)
  234.     size, ok := Val(font+n+1)
  235.     IF ok=0 THEN size := 8
  236.  
  237.     -> remove size part from string
  238.     font[n] := "\0" -> can we guarantee SetStr() to do this?
  239.     SetStr(font, StrLen(font))
  240.   ENDIF
  241.  
  242.   -> add '.font' to name if neccessary
  243.   IF InStr(font, '.font')=-1 THEN StrAdd(font, '.font')
  244.  
  245. EXCEPT DO
  246.   IF req THEN FreeAslRequest(req)
  247. ENDPROC font, size
  248.  
  249. ->-----------------------------------------------------------------------------
  250. -> handy little things...
  251.  
  252. PROC screenerror(err)
  253.   -> sensible names for OpenScreen() errors
  254.   DEF errors:PTR TO LONG
  255.   errors:=[
  256.     'No error',
  257.     'Chosen ModeID is not available',
  258.     'Better chipset required to display this mode',
  259.     'Not enough memory',
  260.     'Not enough chip memory',
  261.     'Public name already in use',
  262.     'Unknown ModeID',
  263.     'Too many bitplanes'
  264.   ]
  265. ENDPROC IF (err<0) OR (err>7) THEN 'Unknown error' ELSE errors[err]
  266.  
  267. PROC msg(msg, args=NIL)
  268.   -> message-printer for WB and shell
  269.   IF wbmessage
  270.     EasyRequestArgs(NIL, [20, 0, 'ShellScr', msg, 'OK'], 0, args)
  271.   ELSE
  272.     VfPrintf(stdout, msg, args)
  273.     PutStr('\n')
  274.   ENDIF
  275. ENDPROC
  276.  
  277. PROC error(header=NIL)
  278.   -> returns string form of DOS Fault. Can prepend header.
  279.   DEF x
  280.   SetStr(x:=String(StrLen(header) + FAULT_MAX + 2),
  281.     Fault(IoErr(), header, x, StrMax(x))
  282.   )
  283. ENDPROC x
  284.  
  285. PROC asl() 
  286.   -> open asl.library only once
  287.  IF aslbase THEN RETURN
  288.  aslbase := OpenLibrary('asl.library', 38)
  289. ENDPROC
  290.  
  291. -> $VER: ShellScr.e 1.4 (10.04.98)
  292. CHAR '$VER: ShellScr 1.4 (10.04.98)',0
  293.